home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / program / pcl4p51.zip / SIMPLE.PAS < prev    next >
Pascal/Delphi Source File  |  1996-06-05  |  5KB  |  175 lines

  1. (*********************************************)
  2. (*                                           *)
  3. (*          SIMPLE.PAS      June 96          *)
  4. (*                                           *)
  5. (*  SIMPLE is provided as the simpliest      *)
  6. (*  possible terminal program using PCL4P    *)
  7. (*                                           *)
  8. (*  This program is donated to the Public    *)
  9. (*  Domain by MarshallSoft Computing, Inc.   *)
  10. (*  It is provided as an example of the use  *)
  11. (*  of the Personal Communications Library.  *)
  12. (*                                           *)
  13. (*********************************************)
  14.  
  15.  
  16. program simple;
  17. uses crt, PCL4P;
  18.  
  19. var
  20.    BaudCode : Integer;
  21.    RetCode  : Integer;
  22.    Byte : Char;
  23.    i    : Integer;
  24.    Port : Integer;
  25.    ResetFlag : Boolean;
  26.    BufPtr    : Pointer;
  27.    BufSeg    : Integer;
  28.  
  29. procedure SayError( Code : Integer );
  30. var
  31.    RetCode : Integer;
  32. begin
  33.    if Code < 0 then RetCode := SioError( Code )
  34.    else if (Code and (FramingError or ParityError or OverrunError)) <> 0 then
  35.       begin (* Port Error *)
  36.          if (Code and FramingError) <> 0 then writeln('Framing Error');
  37.          if (Code and ParityError)  <> 0 then writeln('Parity Error');
  38.          if (Code and OverrunError) <> 0 then writeln('Overrun Error')
  39.       end
  40. end;
  41.  
  42. procedure MyHalt( Code : Integer );
  43. var
  44.    RetCode : Integer;
  45. begin
  46.    if Code < 0 then SayError( Code );
  47.    if ResetFlag then RetCode := SioDone(Port);
  48.    writeln('*** HALTING ***');
  49.    Halt;
  50. end;
  51.  
  52. function MatchBaud(BaudString : String) : Integer;
  53. const
  54.    BaudRateArray : array[1..10] of LongInt =
  55.        (300,600,1200,2400,4800,9600,19200,38400,57600,115200);
  56. var
  57.    i : Integer;
  58.    BaudRate: LongInt;
  59.    RetCode : Integer;
  60. begin
  61.   Val(BaudString,BaudRate,RetCode);
  62.   if RetCode <> 0 then
  63.   begin
  64.     MatchBaud := -1;
  65.     exit;
  66.   end;
  67.   for i := 1 to 10 do if BaudRateArray[i] = BaudRate then
  68.   begin
  69.     MatchBaud := i - 1;
  70.     exit;
  71.   end;
  72.   (* no match *)
  73.   MatchBaud := -1;
  74. end;
  75.  
  76. begin   (* main program *)
  77.    ResetFlag := FALSE;
  78.    (* fetch PORT # from command line *)
  79.    if ParamCount <> 2 then
  80.       begin
  81.          writeln('USAGE: "SIMPLE <port> <baud rate>" where port = 1 to 20');
  82.          halt;
  83.       end;
  84.    Val( ParamStr(1),Port, RetCode );
  85.    if RetCode <> 0 then
  86.       begin
  87.          writeln('Port must be 1 to 16');
  88.          Halt;
  89.       end;
  90.    (* COM1 = 0, COM2 = 1, etc. *)
  91.    Port := Port - 1;
  92.    if (Port<COM1) or (Port>COM16) then
  93.       begin
  94.          writeln('Port must be 1 to 16');
  95.          Halt
  96.       end;
  97.    (* get baud rate *)
  98.    BaudCode := MatchBaud(ParamStr(2));
  99.    (* setup 1K receive buffer *)
  100.    GetMem(BufPtr,1024+16);
  101.    BufSeg := Seg(BufPtr^) + ((Ofs(BufPtr^)+15) SHR 4);
  102.    RetCode := SioRxBuf(Port, BufSeg, Size1024);
  103.    if RetCode < 0 then MyHalt( RetCode );
  104.    if SioInfo('I') > 0 then
  105.      begin
  106.        (* setup 128 transmit buffer *)
  107.        GetMem(BufPtr,128+16);
  108.        BufSeg := Seg(BufPtr^) + ((Ofs(BufPtr^)+15) SHR 4);
  109.        RetCode := SioTxBuf(Port, BufSeg, Size128);
  110.        if RetCode < 0 then MyHalt( RetCode );
  111.      end;
  112.    (* reset port *)
  113.    RetCode := SioReset(Port,BaudCode);
  114.    (* if error then try one more time *)
  115.    if RetCode <> 0 then RetCode := SioReset(Port,BaudCode);
  116.    (* Was port reset ? *)
  117.    if RetCode <> 0 then
  118.      begin
  119.         writeln('Cannot reset COM',Port+1);
  120.         MyHalt( RetCode );
  121.      end;
  122.    (* Port successfully reset *)
  123.    writeln;
  124.    writeln('COM',1+Port,' @ ',ParamStr(2));
  125.    ResetFlag := TRUE;
  126.    (* specify parity, # stop bits, and word length for port *)
  127.    RetCode := SioParms(Port, NoParity, OneStopBit, WordLength8);
  128.    if RetCode < 0 then MyHalt( RetCode );
  129.  
  130.    (* set FIFO level if have INS16550 *)
  131.    RetCode := SioFIFO(Port, LEVEL_8);
  132.    if RetCode < 0 then MyHalt( RetCode );
  133.  
  134.    RetCode := SioRxClear(Port);
  135.    if RetCode < 0 then MyHalt( RetCode );
  136.  
  137.    (* set DTR & RTS *)
  138.    RetCode := SioDTR(Port,SetPort);
  139.    RetCode := SioRTS(Port,SetPort);
  140.    (* begin terminal loop *)
  141.    writeln('Enter terminal loop ( Type ^Z to exit )');
  142.    while TRUE do
  143.       begin
  144.          (* did user press Ctrl-BREAK ? *)
  145.          if SioBrkKey then
  146.             begin
  147.                writeln('User typed Ctl-BREAK');
  148.                RetCode := SioDone(Port);
  149.                Halt;
  150.             end;
  151.          (* check for data overrun *)
  152.          if (SioLine(Port) AND OverrunError) <> 0 then writeln('Overrun!');
  153.          (* anything incoming over serial port ? *)
  154.          RetCode := SioGetc(Port,0);
  155.          if RetCode < -1 then MyHalt( RetCode );
  156.          if RetCode > -1 then Write( chr(RetCode) );
  157.          (* has user pressed keyboard ? *)
  158.          if KeyPressed then
  159.             begin
  160.                (* read keyboard *)
  161.                Byte := ReadKey;
  162.                (* quit if user types ^Z *)
  163.                if Byte = chr($1a) then
  164.                   begin
  165.                      writeln('User typed ^Z');
  166.                      RetCode := SioDone(Port);
  167.                      Halt;
  168.                   end;
  169.                (* send out over serial line *)
  170.                RetCode := SioPutc(Port, Byte );
  171.                if RetCode < 0 then MyHalt( RetCode );
  172.             end
  173.       end
  174. end.
  175.